Sexual Behaviors
Emily Pollock
10 December, 2020
1 Always/Never/Sometimes Condoms
1.1 Casual Relationships
1.1.1 Agecat
svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.other >= 1) %>%
group_by(agecat, cat.cond) %>%
summarize(count=survey_total()) %>%
mutate(prop = count/sum(count)) %>%
ggplot(aes(x=agecat, y=prop, group=cat.cond, color=cat.cond)) +
geom_point() +
geom_line() 
svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.other >= 1) %>%
group_by(age, cat.cond) %>%
summarize(count=survey_total()) %>%
mutate(prop = count/sum(count)) %>%
ggplot(aes(x=age, y=prop, group=cat.cond, color=cat.cond)) +
geom_point() +
geom_line() 
1.1.2 Agecat / Race
svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.other >= 1) %>%
group_by(agecat, race, cat.cond) %>%
summarize(count=survey_total()) %>%
mutate(prop = count/sum(count)) %>%
ggplot(aes(x=race, y=prop, group=cat.cond, color=cat.cond)) +
geom_point() +
geom_line() +
facet_wrap(~agecat)
1.1.3 "Sometimes" Range
svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.other >= 1, cat.cond=="Sometimes") %>%
summarise(mean = survey_mean(p.cond), m=survey_quantile(p.cond, c(0.25, 0.5, 0.75))) %>%
kable() %>%
kable_styling()| mean | mean_se | m_q25 | m_q50 | m_q75 | m_q25_se | m_q50_se | m_q75_se |
|---|---|---|---|---|---|---|---|
| 0.5219673 | 0.0113632 | 0.35 | 0.5 | 0.6666667 | 0.0169841 | 0 | 0.0212302 |
1.2 Marriage/Cohabs
1.2.1 Age
svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.marcoh==1) %>%
group_by(agecat, cat.cond) %>%
summarize(count=survey_total()) %>%
mutate(prop = count/sum(count)) %>%
ggplot(aes(x=agecat, y=prop, group=cat.cond, color=cat.cond)) +
geom_point() +
geom_line()
svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.marcoh==1) %>%
group_by(age, cat.cond) %>%
summarize(count=survey_total()) %>%
mutate(prop = count/sum(count)) %>%
ggplot(aes(x=age, y=prop, group=cat.cond, color=cat.cond)) +
geom_point() +
geom_line()
t <- svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.marcoh==1) %>%
group_by(agecat, cat.cond) %>%
summarize(count=survey_total()) %>%
filter(cat.cond=="Always")1.2.2 Agecat / Race
svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.marcoh==1) %>%
group_by(agecat, race, cat.cond) %>%
summarize(count=survey_total()) %>%
group_by(agecat, race) %>%
mutate(prop = count/sum(count)) %>%
ggplot(aes(x=race, y=prop, group=cat.cond, color=cat.cond)) +
geom_point() +
geom_line() +
facet_wrap(~agecat)
1.2.3 "Sometimes" Range
svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.marcoh== 1, cat.cond=="Sometimes") %>%
summarise(mean = survey_mean(p.cond), m=survey_quantile(p.cond, c(0.25, 0.5, 0.75))) %>%
kable() %>%
kable_styling()| mean | mean_se | m_q25 | m_q50 | m_q75 | m_q25_se | m_q50_se | m_q75_se |
|---|---|---|---|---|---|---|---|
| 0.455076 | 0.0121277 | 0.25 | 0.5 | 0.625 | 0.0254746 | 0.0084915 | 0.0169831 |
2 Sex Acts Per Week
2.1 Casual
2.1.1 Age
meansex <- svy %>%
filter(deg.other >=1, sex4wk<998) %>%
summarize(mean = survey_mean(sex4wk/4, vartype="ci"))
svy %>%
filter(deg.other >= 1, sex4wk<998) %>%
group_by(agecat) %>%
summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
ggplot(aes(x=agecat, y=mean, color=agecat)) +
geom_point() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9)) +
ggtitle("Sex Acts Per Week by Agecat") 
svy %>%
filter(deg.other >= 1, sex4wk<998) %>%
group_by(age) %>%
summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
ggplot(aes(x=age, y=mean, color=age)) +
geom_point() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9)) +
ggtitle("Sex Acts Per Week by Age") 
2.1.2 Age / Race
svy %>%
filter(deg.other >= 1, sex4wk<998) %>%
group_by(race, agecat) %>%
summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
ggplot(aes(x=race, y=mean, color=race)) +
geom_point() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9)) +
facet_wrap(~agecat) +
ggtitle("Sex Acts Per Week by Agecat/Race") 
2.2 Marriage/Cohab
2.2.1 Age
meansex <- svy %>%
filter(deg.marcoh==1, sex4wk<998) %>%
summarize(mean = survey_mean(sex4wk/4, vartype="ci"))
svy %>%
filter(deg.marcoh == 1, sex4wk<998) %>%
group_by(agecat) %>%
summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
ggplot(aes(x=agecat, y=mean, color=agecat)) +
geom_point() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9)) +
ggtitle("Sex Acts Per Week by Agecat") 
svy %>%
filter(deg.marcoh == 1, sex4wk<998) %>%
group_by(age) %>%
summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
ggplot(aes(x=age, y=mean, color=age)) +
geom_point() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9)) +
ggtitle("Sex Acts Per Week by Age") 
2.2.2 Age / Race
svy %>%
filter(deg.other >= 1, sex4wk<998) %>%
group_by(race, agecat) %>%
summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
ggplot(aes(x=race, y=mean, color=race)) +
geom_point() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9)) +
facet_wrap(~agecat) +
ggtitle("Sex Acts Per Week by Agecat/Race") +
ylim(0,3)
3 old - By Age Range (Condensed Age Categories)
1 = 15-24 year olds
2 = 25-34 year olds
3 = 35-44 year olds
3.1 Degree Dist
this is using the egodata used in ch 1 for demography sims - but I should probably either add back in the over-45 alters for the "typical" 35-44 year old experience? or remove older alters for lower ages too (i.e. over 25 years old in youngest...)
degs <- svy %>%
mutate(sex=as.factor(sex), deg.marcoh=as.factor(deg.marcoh), deg.other=as.factor(deg.other), agerange=as.factor(agerange)) %>%
group_by(agerange, sex, deg.marcoh, deg.other, .drop = FALSE) %>%
summarize(n = survey_total()) %>%
group_by(agerange, sex) %>%
mutate(prop = n/sum(n)) %>%
select(-n, -n_se) %>%
pivot_wider(names_from = deg.other, values_from=prop)
degs <- degs[,-c(1:2)]
degs[,2:5] <- round(degs[,2:5],3)
degs %>%
kable() %>%
kable_styling("striped") %>%
pack_rows("Age Range 1", 1, 4) %>%
pack_rows("Females", 1, 2) %>%
pack_rows("Males", 3, 4) %>%
pack_rows("Age Range 2", 5, 8) %>%
pack_rows("Age Range 3", 9, 12) %>%
pack_rows("Females", 5, 6) %>%
pack_rows("Males", 7, 8) %>%
pack_rows("Females", 9, 10) %>%
pack_rows("Males", 11, 12) %>%
add_header_above(c(" "=1, "Deg Casual"=4))| deg.marcoh | 0 | 1 | 2 | 3 |
|---|---|---|---|---|
| Age Range 1 | ||||
| Females | ||||
| 0 | 0.546 | 0.244 | 0.003 | 0.001 |
| 1 | 0.204 | 0.002 | 0.000 | 0.000 |
| Males | ||||
| 0 | 0.640 | 0.214 | 0.012 | 0.002 |
| 1 | 0.130 | 0.002 | 0.000 | 0.000 |
| Age Range 2 | ||||
| Females | ||||
| 0 | 0.231 | 0.125 | 0.004 | 0.001 |
| 1 | 0.636 | 0.002 | 0.000 | 0.000 |
| Males | ||||
| 0 | 0.248 | 0.139 | 0.008 | 0.002 |
| 1 | 0.600 | 0.003 | 0.000 | 0.000 |
| Age Range 3 | ||||
| Females | ||||
| 0 | 0.443 | 0.067 | 0.002 | 0.000 |
| 1 | 0.488 | 0.001 | 0.000 | 0.000 |
| Males | ||||
| 0 | 0.260 | 0.066 | 0.004 | 0.001 |
| 1 | 0.665 | 0.004 | 0.000 | 0.000 |
3.2 Condoms: Proportion Always/Never/Sometimes
3.2.1 Casual
cas.condoms <- svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.other >= 1) %>%
group_by(agerange, cat.cond) %>%
summarize(count=survey_total()) %>%
mutate(prop = count/sum(count)) %>%
ggplot(aes(x=cat.cond, y=prop, fill=cat.cond)) +
geom_col() +
facet_wrap(~agerange)
ggplotly(cas.condoms)## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.other >= 1, cat.cond=="Sometimes") %>%
group_by(agerange) %>%
summarise(mean = round(survey_mean(p.cond),2), m=round(survey_quantile(p.cond, c(0.25, 0.5, 0.75)), 3)) %>%
kable(caption="Distribution of Sometimes Condoms") %>%
kable_styling()## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available
## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available| agerange | mean | mean_se | m_q25 | m_q50 | m_q75 | m_q25_se | m_q50_se | m_q75_se |
|---|---|---|---|---|---|---|---|---|
| 1 | 0.53 | 0.02 | 0.40 | 0.5 | 0.667 | 0.047 | 0.025 | 0.021 |
| 2 | 0.52 | 0.02 | 0.40 | 0.5 | 0.667 | 0.036 | 0.000 | 0.038 |
| 3 | 0.48 | 0.04 | 0.25 | 0.5 | 0.750 | 0.043 | 0.067 | 0.021 |
3.2.2 Marriage/Cohab
mar.condoms <- svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.marcoh >= 1) %>%
group_by(agerange, cat.cond) %>%
summarize(count=survey_total()) %>%
mutate(prop = count/sum(count)) %>%
ggplot(aes(x=cat.cond, y=prop, fill=cat.cond)) +
geom_col() +
facet_wrap(~agerange)
ggplotly(mar.condoms)svy %>%
mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
filter(deg.marcoh == 1, cat.cond=="Sometimes") %>%
group_by(agerange) %>%
summarise(mean = round(survey_mean(p.cond),2), m=round(survey_quantile(p.cond, c(0.25, 0.5, 0.75)), 3)) %>%
kable(caption="Distribution of Sometimes Condoms") %>%
kable_styling()## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available
## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available
## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available| agerange | mean | mean_se | m_q25 | m_q50 | m_q75 | m_q25_se | m_q50_se | m_q75_se |
|---|---|---|---|---|---|---|---|---|
| 1 | 0.47 | 0.03 | 0.25 | 0.5 | 0.667 | 0.042 | 0.025 | 0.038 |
| 2 | 0.45 | 0.02 | 0.25 | 0.5 | 0.625 | 0.025 | 0.018 | 0.017 |
| 3 | 0.45 | 0.02 | 0.25 | 0.5 | 0.667 | 0.034 | 0.032 | 0.042 |
3.3 Sex Acts Per Week
3.3.1 Casual
cas.acts <- svy %>%
filter(deg.other >= 1, sex4wk<998) %>%
mutate(agerange = as.factor(agerange)) %>%
group_by(agerange) %>%
summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
ggplot(aes(x=agerange, y=mean, color=agerange)) +
geom_point() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9)) +
ggtitle("Sex Acts Per Week by Age Range")
ggplotly(cas.acts)3.3.2 Marriage/Cohab
mar.acts <- svy %>%
filter(deg.marcoh == 1, sex4wk<998) %>%
mutate(agerange = as.factor(agerange)) %>%
group_by(agerange) %>%
summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
ggplot(aes(x=agerange, y=mean, color=agerange)) +
geom_point() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9)) +
ggtitle("Sex Acts Per Week by Age Range")
ggplotly(mar.acts)4 old - Proportion of Sex Acts w/ Condom in Last Week
4.1 Causal Relationships
4.1.1 Age
cas.agecat.med <- svy %>%
filter(deg.other >= 1) %>%
group_by(agecat) %>%
summarize(med = survey_median(p.cond, vartype=NULL))
cas.agecat <- svy %>%
filter(deg.other >= 1) %>%
group_by(agecat) %>%
summarize(mean = survey_mean(p.cond, vartype="ci")) %>%
ggplot(aes(x=agecat, y=mean)) +
geom_point() +
geom_line() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9))+
geom_point(data=cas.agecat.med, aes(y=med), color="blue")
ggplotly(cas.agecat)4.1.2 Race
cas.race.med <- svy %>%
filter(deg.other >= 1) %>%
group_by(race) %>%
summarize(med = survey_median(p.cond, vartype=NULL))
cas.race <- svy %>%
filter(deg.other >= 1) %>%
group_by(race) %>%
summarize(mean = survey_mean(p.cond, vartype="ci")) %>%
ggplot(aes(x=race, y=mean)) +
geom_point() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9))+
geom_point(data=cas.race.med, aes(y=med), color="blue")
ggplotly(cas.race)4.1.3 Activity Level
cas.deg.med <- svy %>%
filter(deg.other >= 1) %>%
group_by(deg.other) %>%
summarize(med = survey_median(p.cond, vartype=NULL))
cas.deg <- svy %>%
filter(deg.other >= 1) %>%
group_by(deg.other) %>%
summarize(mean = survey_mean(p.cond, vartype="ci")) %>%
ggplot(aes(x=deg.other, y=mean)) +
geom_point() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9))+
geom_point(data=cas.deg.med, aes(y=med), color="blue")
ggplotly(cas.deg)4.1.4 Joint
cas.joint <- svy %>%
filter(deg.other >= 1) %>%
mutate(deg.other=as.factor(deg.other)) %>%
group_by(deg.other, agecat, race) %>%
summarize(mean = survey_mean(p.cond, vartype=NULL)) %>%
ggplot(aes(x=agecat, y=mean, group=deg.other, color=deg.other)) +
geom_point() +
facet_wrap(~race)
ggplotly(cas.joint)4.2 Marriage/Cohabs
4.2.1 Age
mar.agecat.med <- svy %>%
filter(deg.marcoh >= 1) %>%
group_by(agecat) %>%
summarize(med = survey_median(p.cond, vartype=NULL))
mar.agecat <- svy %>%
filter(deg.marcoh >= 1) %>%
group_by(agecat) %>%
summarize(mean = survey_mean(p.cond, vartype="ci")) %>%
ggplot(aes(x=agecat, y=mean)) +
geom_point() +
geom_line() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9))+
geom_point(data=mar.agecat.med, aes(y=med), color="blue")
ggplotly(mar.agecat)4.2.2 Race
mar.race.med <- svy %>%
filter(deg.marcoh >= 1) %>%
group_by(race) %>%
summarize(med = survey_median(p.cond, vartype=NULL))
mar.race <- svy %>%
filter(deg.marcoh >= 1) %>%
group_by(race) %>%
summarize(mean = survey_mean(p.cond, vartype="ci")) %>%
ggplot(aes(x=race, y=mean)) +
geom_point() +
geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
position=position_dodge(.9))+
geom_point(data=mar.race.med, aes(y=med), color="blue")
ggplotly(mar.race)